home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / goonix / ioext.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-07-02  |  22.1 KB  |  1,075 lines
  1. /*    Copyright (C) 1995 Free Software Foundation, Inc.
  2.  * 
  3.  * This program is free software; you can redistribute it and/or modify
  4.  * it under the terms of the GNU General Public License as published by
  5.  * the Free Software Foundation; either version 2, or (at your option)
  6.  * any later version.
  7.  * 
  8.  * This program is distributed in the hope that it will be useful,
  9.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11.  * GNU General Public License for more details.
  12.  * 
  13.  * You should have received a copy of the GNU General Public License
  14.  * along with this software; see the file COPYING.  If not, write to
  15.  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  16.  *
  17.  * As a special exception, the Free Software Foundation gives permission
  18.  * for additional uses of the text contained in its release of GUILE.
  19.  *
  20.  * The exception is that, if you link the GUILE library with other files
  21.  * to produce an executable, this does not by itself cause the
  22.  * resulting executable to be covered by the GNU General Public License.
  23.  * Your use of that executable is in no way restricted on account of
  24.  * linking the GUILE library code into it.
  25.  *
  26.  * This exception does not however invalidate any other reasons why
  27.  * the executable file might be covered by the GNU General Public License.
  28.  *
  29.  * This exception applies only to the code released by the
  30.  * Free Software Foundation under the name GUILE.  If you copy
  31.  * code from other Free Software Foundation releases into a copy of
  32.  * GUILE, as the General Public License permits, the exception does
  33.  * not apply to the code that you add in this way.  To avoid misleading
  34.  * anyone as to the status of such modified files, you must delete
  35.  * this exception notice from them.
  36.  *
  37.  * If you write modifications of your own for GUILE, it is your choice
  38.  * whether to permit this exception to apply to your modifications.
  39.  * If you do not wish that, delete this exception notice.  
  40.  */
  41.  
  42.  
  43. #include <stdio.h>
  44. #include "_scm.h"
  45.  
  46. #ifdef __EMX__
  47. # include <sys/types.h>
  48. #endif
  49.  
  50. #ifdef HAVE_UNISTD_H
  51. #   include <unistd.h>
  52. #endif
  53.  
  54. #include <sys/stat.h>
  55. extern char *getcwd ();
  56.  
  57. #if HAVE_DIRENT_H
  58. # include <dirent.h>
  59. # define NAMLEN(dirent) strlen((dirent)->d_name)
  60. #else
  61. # define dirent direct
  62. # define NAMLEN(dirent) (dirent)->d_namlen
  63. # if HAVE_SYS_NDIR_H
  64. #  include <sys/ndir.h>
  65. # endif
  66. # if HAVE_SYS_DIR_H
  67. #  include <sys/dir.h>
  68. # endif
  69. # if HAVE_NDIR_H
  70. #  include <ndir.h>
  71. # endif
  72. #endif
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79. PROC (s_read_line, "read-line", 0, 1, 0, scm_read_line);
  80. #ifdef __STDC__
  81. SCM 
  82. scm_read_line (SCM port)
  83. #else
  84. SCM 
  85. scm_read_line (port)
  86.      SCM port;
  87. #endif
  88. {
  89.   register int c;
  90.   register int j = 0;
  91.   sizet len = 30;
  92.   SCM tok_buf = scm_makstr ((long) len, 0);
  93.   register char *p = CHARS (tok_buf);
  94.   if (UNBNDP (port))
  95.     port = cur_inp;
  96.   else
  97.     ASSERT (NIMP (port) && OPINPORTP (port), port, ARG1, s_read_line);
  98.   if (EOF == (c = scm_lgetc (port)))
  99.     return EOF_VAL;
  100.   while (1)
  101.     {
  102.       switch (c)
  103.     {
  104.     case LINE_INCREMENTORS:
  105.     case EOF:
  106.       if (len == j)
  107.         return tok_buf;
  108.       return scm_resizuve (tok_buf, (SCM) MAKINUM (j));
  109.     default:
  110.       if (j >= len)
  111.         {
  112.           p = scm_grow_tok_buf (tok_buf);
  113.           len = LENGTH (tok_buf);
  114.         }
  115.       p[j++] = c;
  116.       c = scm_lgetc (port);
  117.     }
  118.     }
  119. }
  120.  
  121.  
  122.  
  123. PROC (s_read_line_x, "read-line!", 1, 1, 0, scm_read_line_x);
  124. #ifdef __STDC__
  125. SCM 
  126. scm_read_line_x (SCM str, SCM port)
  127. #else
  128. SCM 
  129. scm_read_line_x (str, port)
  130.      SCM str;
  131.      SCM port;
  132. #endif
  133. {
  134.   register int c;
  135.   register int j = 0;
  136.   register char *p;
  137.   sizet len;
  138.   ASSERT (NIMP (str) && STRINGP (str), str, ARG1, s_read_line_x);
  139.   p = CHARS (str);
  140.   len = LENGTH (str);
  141.   if UNBNDP
  142.     (port) port = cur_inp;
  143.   else
  144.     ASSERT (NIMP (port) && OPINPORTP (port), port, ARG2, s_read_line_x);
  145.   c = scm_lgetc (port);
  146.   if (EOF == c)
  147.     return EOF_VAL;
  148.   while (1)
  149.     {
  150.       switch (c)
  151.     {
  152.     case LINE_INCREMENTORS:
  153.     case EOF:
  154.       return MAKINUM (j);
  155.     default:
  156.       if (j >= len)
  157.         {
  158.           scm_lungetc (c, port);
  159.           return BOOL_F;
  160.         }
  161.       p[j++] = c;
  162.       c = scm_lgetc (port);
  163.     }
  164.     }
  165. }
  166.  
  167.  
  168.  
  169. PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line);
  170. #ifdef __STDC__
  171. SCM 
  172. scm_write_line (SCM obj, SCM port)
  173. #else
  174. SCM 
  175. scm_write_line (obj, port)
  176.      SCM obj;
  177.      SCM port;
  178. #endif
  179. {
  180.   scm_display (obj, port);
  181.   return scm_newline (port);
  182. }
  183.  
  184.  
  185.  
  186. PROC (s_sys_ftell, "%ftell", 1, 0, 0, scm_sys_ftell);
  187. #ifdef __STDC__
  188. SCM 
  189. scm_sys_ftell (SCM port)
  190. #else
  191. SCM 
  192. scm_sys_ftell (port)
  193.      SCM port;
  194. #endif
  195. {
  196.   long pos;
  197.   ASSERT (NIMP (port) && OPFPORTP (port), port, ARG1, s_sys_ftell);
  198.   SYSCALL (pos = ftell (STREAM (port)));
  199.   if (pos < 0)
  200.     return BOOL_F;
  201.   if (pos > 0 && CRDYP (port))
  202.     pos--;
  203.   return MAKINUM (pos);
  204. }
  205.  
  206.  
  207.  
  208. PROC (s_sys_fseek, "%fseek", 3, 0, 0, scm_sys_fseek);
  209. #ifdef __STDC__
  210. SCM 
  211. scm_sys_fseek (SCM port, SCM offset, SCM whence)
  212. #else
  213. SCM 
  214. scm_sys_fseek (port, offset, whence)
  215.      SCM port;
  216.      SCM offset;
  217.      SCM whence;
  218. #endif
  219. {
  220.   int rv;
  221.   ASSERT (NIMP (port) && OPFPORTP (port), port, ARG1, s_sys_fseek);
  222.   ASSERT (INUMP (offset), offset, ARG2, s_sys_fseek);
  223.   ASSERT (INUMP (whence) && (INUM (whence) < 3) && (INUM (whence) >= 0),
  224.       whence, ARG3, s_sys_fseek);
  225.   CLRDY (port);            /* Clear ungetted char */
  226.   /* Values of whence are interned in scm_init_ioext.  */
  227.   rv = fseek (STREAM (port), INUM (offset), INUM (whence));
  228.   return rv ? BOOL_F : BOOL_T;
  229. }
  230.  
  231.  
  232.  
  233. PROC (s_sys_freopen, "%freopen", 3, 0, 0, scm_sys_freopen);
  234. #ifdef __STDC__
  235. SCM 
  236. scm_sys_freopen (SCM filename, SCM modes, SCM port)
  237. #else
  238. SCM 
  239. scm_sys_freopen (filename, modes, port)
  240.      SCM filename;
  241.      SCM modes;
  242.      SCM port;
  243. #endif
  244. {
  245.   FILE *f;
  246.   ASSERT (NIMP (filename) && STRINGP (filename), filename, ARG1, s_sys_freopen);
  247.   ASSERT (NIMP (modes) && STRINGP (modes), modes, ARG2, s_sys_freopen);
  248.   DEFER_INTS;
  249.   ASSERT (NIMP (port) && FPORTP (port) && CLOSEDP (port), port, ARG3, s_sys_freopen);
  250.   SYSCALL (f = freopen (CHARS (filename), CHARS (modes), STREAM (port)));
  251.   if (!f)
  252.     {
  253.       CAR (port) &= ~OPN;
  254.       scm_remove_from_port_table (port);
  255.       port = BOOL_F;
  256.     }
  257.   else
  258.     {
  259.       CAR (port) = tc16_fport | scm_mode_bits (CHARS (modes));
  260.       SETSTREAM (port, f);
  261.       if (BUF0 & (CAR (port) = tc16_fport | scm_mode_bits (CHARS (modes))))
  262.     scm_setbuf0 (port);
  263.     }
  264.   ALLOW_INTS;
  265.   return port;
  266. }
  267.  
  268.  
  269.  
  270. PROC (s_sys_duplicate_port, "%duplicate-port", 2, 0, 0, scm_sys_duplicate_port);
  271. #ifdef __STDC__
  272. SCM 
  273. scm_sys_duplicate_port (SCM oldpt, SCM modes)
  274. #else
  275. SCM 
  276. scm_sys_duplicate_port (oldpt, modes)
  277.      SCM oldpt;
  278.      SCM modes;
  279. #endif
  280. {
  281.   int oldfd;
  282.   int newfd;
  283.   FILE *f;
  284.   SCM newpt;
  285.   ASSERT (NIMP (oldpt) && OPPORTP (oldpt), oldpt, ARG1, s_sys_duplicate_port);
  286.   ASSERT (NIMP (modes) && STRINGP (modes), modes, ARG2, s_sys_duplicate_port);
  287.   NEWCELL (newpt);
  288.   DEFER_INTS;
  289.   oldfd = fileno (STREAM (oldpt));
  290.   if (oldfd == -1)
  291.     {
  292.       ALLOW_INTS;
  293.       return BOOL_F;
  294.     };
  295.   SYSCALL (newfd = dup (oldfd));
  296.   if (newfd == -1)
  297.     {
  298.       ALLOW_INTS;
  299.       return BOOL_F;
  300.     };
  301.   f = fdopen (newfd, CHARS (modes));
  302.   if (!f)
  303.     {
  304.       SYSCALL (close (newfd));
  305.       ALLOW_INTS;
  306.       return BOOL_F;
  307.     }
  308.   SETSTREAM (newpt, f);
  309.   if (BUF0 & (CAR (newpt) = tc16_fport | scm_mode_bits (CHARS (modes))))
  310.     scm_setbuf0 (newpt);
  311.   scm_add_to_port_table (newpt);
  312.   ALLOW_INTS;
  313.   return newpt;
  314. }
  315.  
  316.  
  317.  
  318. PROC (s_sys_redirect_port, "%redirect-port", 2, 0, 0, scm_sys_redirect_port);
  319. #ifdef __STDC__
  320. SCM 
  321. scm_sys_redirect_port (SCM into_pt, SCM from_pt)
  322. #else
  323. SCM 
  324. scm_sys_redirect_port (into_pt, from_pt)
  325.      SCM into_pt;
  326.      SCM from_pt;
  327. #endif
  328. {
  329.   int ans, oldfd, newfd;
  330.   DEFER_INTS;
  331.   ASSERT (NIMP (into_pt) && OPPORTP (into_pt), into_pt, ARG1, s_sys_redirect_port);
  332.   ASSERT (NIMP (from_pt) && OPPORTP (from_pt), from_pt, ARG2, s_sys_redirect_port);
  333.   oldfd = fileno (STREAM (into_pt));
  334.   newfd = fileno (STREAM (from_pt));
  335.   if (oldfd == -1 || newfd == -1)
  336.     ans = -1;
  337.   else
  338.     SYSCALL (ans = dup2 (oldfd, newfd));
  339.   ALLOW_INTS;
  340.   return (ans == -1) ? BOOL_F : BOOL_T;
  341. }
  342.  
  343.  
  344. static long scm_tc16_dir;
  345.  
  346. PROC (s_sys_opendir, "%opendir", 1, 0, 0, scm_sys_opendir);
  347. #ifdef __STDC__
  348. SCM 
  349. scm_sys_opendir (SCM dirname)
  350. #else
  351. SCM 
  352. scm_sys_opendir (dirname)
  353.      SCM dirname;
  354. #endif
  355. {
  356.   DIR *ds;
  357.   SCM dir;
  358.   ASSERT (NIMP (dirname) && STRINGP (dirname), dirname, ARG1, s_sys_opendir);
  359.   NEWCELL (dir);
  360.   DEFER_INTS;
  361.   SYSCALL (ds = opendir (CHARS (dirname)));
  362.   if (!ds)
  363.     {
  364.       ALLOW_INTS;
  365.       return BOOL_F;
  366.     }
  367.   CAR (dir) = scm_tc16_dir | OPN;
  368.   SETCDR (dir, ds);
  369.   ALLOW_INTS;
  370.   return dir;
  371. }
  372.  
  373.  
  374.  
  375. PROC (s_sys_readdir, "%readdir", 1, 0, 0, scm_sys_readdir);
  376. #ifdef __STDC__
  377. SCM 
  378. scm_sys_readdir (SCM port)
  379. #else
  380. SCM 
  381. scm_sys_readdir (port)
  382.      SCM port;
  383. #endif
  384. {
  385.   struct dirent *rdent;
  386.   DEFER_INTS;
  387.   ASSERT (OPDIRP (port), port, ARG1, s_sys_readdir);
  388.   errno = 0;
  389.   SYSCALL (rdent = readdir ((DIR *) CDR (port)));
  390.   ALLOW_INTS;
  391.   return (rdent
  392.       ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
  393.       : (errno ? BOOL_F : EOF_VAL));
  394. }
  395.  
  396.  
  397.  
  398. PROC (s_rewinddir, "rewinddir", 1, 0, 0, scm_rewinddir);
  399. #ifdef __STDC__
  400. SCM 
  401. scm_rewinddir (SCM port)
  402. #else
  403. SCM 
  404. scm_rewinddir (port)
  405.      SCM port;
  406. #endif
  407. {
  408.   ASSERT (OPDIRP (port), port, ARG1, s_rewinddir);
  409.   rewinddir ((DIR *) CDR (port));
  410.   return UNSPECIFIED;
  411. }
  412.  
  413.  
  414.  
  415. PROC (s_sys_closedir, "%closedir", 1, 0, 0, scm_sys_closedir);
  416. #ifdef __STDC__
  417. SCM 
  418. scm_sys_closedir (SCM port)
  419. #else
  420. SCM 
  421. scm_sys_closedir (port)
  422.      SCM port;
  423. #endif
  424. {
  425.   int sts;
  426.   ASSERT (DIRP (port), port, ARG1, s_sys_closedir);
  427.   DEFER_INTS;
  428.   if (CLOSEDP (port))
  429.     {
  430.       ALLOW_INTS;
  431.       return BOOL_F;
  432.     }
  433.   SYSCALL (sts = closedir ((DIR *) CDR (port)));
  434.   if (sts)
  435.     {
  436.       ALLOW_INTS;
  437.       return BOOL_F;
  438.     }
  439.   CAR (port) = scm_tc16_dir;
  440.   ALLOW_INTS;
  441.   return BOOL_T;
  442. }
  443.  
  444.  
  445.  
  446. #ifdef __STDC__
  447. static int 
  448. scm_dir_print (SCM sexp, SCM port, int writing)
  449. #else
  450. static int 
  451. scm_dir_print (sexp, port, writing)
  452.      SCM sexp;
  453.      SCM port;
  454.      int writing;
  455. #endif
  456. {
  457.   scm_prinport (sexp, port, "directory");
  458.   return !0;
  459. }
  460.  
  461.  
  462.  
  463. #ifdef __STDC__
  464. static sizet 
  465. scm_dir_free (SCM p)
  466. #else
  467. static sizet 
  468. scm_dir_free (p)
  469.      SCM p;
  470. #endif
  471. {
  472.   if (OPENP (p))
  473.     closedir ((DIR *) CDR (p));
  474.   return 0;
  475. }
  476.  
  477. static scm_smobfuns dir_smob = {scm_mark0, scm_dir_free, scm_dir_print, 0};
  478.  
  479.  
  480. PROC (s_sys_mkdir, "%mkdir", 1, 1, 0, scm_sys_mkdir);
  481. #ifdef __STDC__
  482. SCM 
  483. scm_sys_mkdir (SCM path, SCM mode)
  484. #else
  485. SCM 
  486. scm_sys_mkdir (path, mode)
  487.      SCM path;
  488.      SCM mode;
  489. #endif
  490. {
  491. #ifdef HAVE_MKDIR
  492.   int rv;
  493.   mode_t mask;
  494.   ASSERT (NIMP (path) && STRINGP (path), path, ARG1, s_sys_mkdir);
  495.   if (UNBNDP (mode))
  496.     {
  497.       mask = umask (0);
  498.       umask (mask);
  499.       SYSCALL (rv = mkdir (CHARS (path), 0777 ^ mask));
  500.     }
  501.   else
  502.     {
  503.       ASSERT (INUMP (mode), mode, ARG2, s_sys_mkdir);
  504.       SYSCALL (rv = mkdir (CHARS (path), INUM (mode)));
  505.     }
  506.   return rv ? BOOL_F : BOOL_T;
  507. #else
  508.   return BOOL_F;
  509. #endif
  510. }
  511.  
  512.  
  513. PROC (s_sys_rmdir, "%rmdir", 1, 0, 0, scm_sys_rmdir);
  514. #ifdef __STDC__
  515. SCM 
  516. scm_sys_rmdir (SCM path)
  517. #else
  518. SCM 
  519. scm_sys_rmdir (path)
  520.      SCM path;
  521. #endif
  522. {
  523. #ifdef HAVE_RMDIR
  524.   int val;
  525.   ASSERT (NIMP (path) && STRINGP (path), path, ARG1, s_sys_rmdir);
  526.   SYSCALL (val = rmdir (CHARS (path)));
  527.   return val ? BOOL_F : BOOL_T;
  528. #else
  529.   return BOOL_F;
  530. #endif
  531. }
  532.  
  533.  
  534.  
  535. PROC (s_sys_chdir, "%chdir", 1, 0, 0, scm_sys_chdir);
  536. #ifdef __STDC__
  537. SCM 
  538. scm_sys_chdir (SCM str)
  539. #else
  540. SCM 
  541. scm_sys_chdir (str)
  542.      SCM str;
  543. #endif
  544. {
  545.   int ans;
  546.   ASSERT (NIMP (str) && STRINGP (str), str, ARG1, s_sys_chdir);
  547.   SYSCALL (ans = chdir (CHARS (str)));
  548.   return ans ? BOOL_F : BOOL_T;
  549. }
  550.  
  551.  
  552.  
  553. PROC (s_sys_getcwd, "%getcwd", 0, 0, 0, scm_sys_getcwd);
  554. #ifdef __STDC__
  555. SCM 
  556. scm_sys_getcwd (void)
  557. #else
  558. SCM 
  559. scm_sys_getcwd ()
  560. #endif
  561. {
  562. #ifdef HAVE_GETCWD
  563.   char *rv;
  564.  
  565.   sizet size = 100;
  566.   char *wd;
  567.   SCM result = BOOL_F;
  568.  
  569.   DEFER_INTS;
  570.   wd = scm_must_malloc (size, s_sys_getcwd);
  571.   while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
  572.     {
  573.       scm_must_free (wd);
  574.       size *= 2;
  575.       wd = scm_must_malloc (size, s_sys_getcwd);
  576.     }
  577.   if (rv != 0)
  578.     result = scm_makfromstr (wd, strlen (wd), 0);
  579.   scm_must_free (wd);
  580.   ALLOW_INTS;
  581.   return result;
  582. #else
  583.   return BOOL_F;
  584. #endif
  585. }
  586.  
  587.  
  588.  
  589. PROC (s_sys_chmod, "%chmod", 2, 0, 0, scm_sys_chmod);
  590. #ifdef __STDC__
  591. SCM 
  592. scm_sys_chmod (SCM port_or_path, SCM mode)
  593. #else
  594. SCM 
  595. scm_sys_chmod (port_or_path, mode)
  596.      SCM port_or_path;
  597.      SCM mode;
  598. #endif
  599. {
  600.   int rv;
  601.   ASSERT (INUMP (mode), mode, ARG2, s_sys_chmod);
  602.   ASSERT (NIMP (port_or_path), port_or_path, ARG1, s_sys_chmod);
  603.   if (STRINGP (port_or_path))
  604.     SYSCALL (rv = chmod (CHARS (port_or_path), INUM (mode)));
  605.   else
  606.     {
  607.       ASSERT (OPFPORTP (port_or_path), port_or_path, ARG1, s_sys_chmod);
  608.       rv = fileno (STREAM (port_or_path));
  609.       if (rv != -1)
  610.     SYSCALL (rv = fchmod (rv, INUM (mode)));
  611.     }
  612.   return rv ? BOOL_F : BOOL_T;
  613. }
  614.  
  615.  
  616.  
  617. #ifdef __EMX__
  618. #include <sys/utime.h>
  619. #else
  620. #include <utime.h>
  621. #endif
  622.  
  623. PROC (s_sys_utime, "%utime", 1, 2, 0, scm_sys_utime);
  624. #ifdef __STDC__
  625. SCM 
  626. scm_sys_utime (SCM pathname, SCM actime, SCM modtime)
  627. #else
  628. SCM 
  629. scm_sys_utime (pathname, actime, modtime)
  630.      SCM pathname;
  631.      SCM actime;
  632.      SCM modtime;
  633. #endif
  634. {
  635.   int rv;
  636.   struct utimbuf utm_tmp;
  637.  
  638.   ASSERT (NIMP (pathname) && STRINGP (pathname), pathname, ARG1, s_sys_utime);
  639.  
  640.   if (UNBNDP (actime))
  641.     SYSCALL (time (&utm_tmp.actime));
  642.   else
  643.     utm_tmp.actime = scm_num2ulong (actime, (char *) ARG2, s_sys_utime);
  644.  
  645.   if (UNBNDP (modtime))
  646.     SYSCALL (time (&utm_tmp.modtime));
  647.   else
  648.     utm_tmp.modtime = scm_num2ulong (modtime, (char *) ARG3, s_sys_utime);
  649.  
  650.   SYSCALL (rv = utime (CHARS (pathname), &utm_tmp));
  651.   return rv ? BOOL_F : BOOL_T;
  652. }
  653.  
  654.  
  655.  
  656. PROC (s_umask, "umask", 0, 1, 0, scm_umask);
  657. #ifdef __STDC__
  658. SCM 
  659. scm_umask (SCM mode)
  660. #else
  661. SCM 
  662. scm_umask (mode)
  663.      SCM mode;
  664. #endif
  665. {
  666.   mode_t mask;
  667.   if (UNBNDP (mode))
  668.     {
  669.       mask = umask (0);
  670.       umask (mask);
  671.     }
  672.   else {
  673.     ASSERT (INUMP (mode), mode, ARG1, s_umask);
  674.     mask = umask (INUM (mode));
  675.   }
  676.   return MAKINUM (mask);
  677. }
  678.  
  679.  
  680.  
  681. PROC (s_sys_rename, "%rename", 2, 0, 0, scm_sys_rename);
  682. #ifdef __STDC__
  683. SCM 
  684. scm_sys_rename (SCM oldname, SCM newname)
  685. #else
  686. SCM 
  687. scm_sys_rename (oldname, newname)
  688.      SCM oldname;
  689.      SCM newname;
  690. #endif
  691. {
  692.   int rv;
  693.   ASSERT (NIMP (oldname) && STRINGP (oldname), oldname, ARG1, s_sys_rename);
  694.   ASSERT (NIMP (newname) && STRINGP (newname), newname, ARG2, s_sys_rename);
  695. #ifdef STDC_HEADERS
  696.   SYSCALL (rv = rename (CHARS (oldname), CHARS (newname)));
  697.   return rv ? BOOL_F : BOOL_T;
  698. #else
  699.   DEFER_INTS;
  700.   SYSCALL (rv = link (CHARS (oldname), CHARS (newname)));
  701.   if (!rv)
  702.     {
  703.       SYSCALL (rv = unlink (CHARS (oldname)));;
  704.       if (rv)
  705.     /* unlink failed.  remove new name */
  706.     SYSCALL (unlink (CHARS (newname))); 
  707.     }
  708.   ALLOW_INTS;
  709.   return rv ? BOOL_F : BOOL_T;
  710. #endif
  711. }
  712.  
  713.  
  714.  
  715. PROC (s_sys_fileno, "%fileno", 1, 0, 0, scm_sys_fileno);
  716. #ifdef __STDC__
  717. SCM 
  718. scm_sys_fileno (SCM port)
  719. #else
  720. SCM 
  721. scm_sys_fileno (port)
  722.      SCM port;
  723. #endif
  724. {
  725.   int fd;
  726.   ASSERT (NIMP (port) && OPFPORTP (port), port, ARG1, s_sys_fileno);
  727.   fd = fileno (STREAM (port));
  728.   return (fd == -1) ? BOOL_F : MAKINUM (fd);
  729. }
  730.  
  731.  
  732.  
  733. PROC (s_sys_isatty, "%isatty", 1, 0, 0, scm_sys_isatty);
  734. #ifdef __STDC__
  735. SCM 
  736. scm_sys_isatty (SCM port)
  737. #else
  738. SCM 
  739. scm_sys_isatty (port)
  740.      SCM port;
  741. #endif
  742. {
  743.   int rv;
  744.   ASSERT (NIMP (port) && OPFPORTP (port), port, ARG1, s_sys_isatty);
  745.   rv = fileno (STREAM (port));
  746.   if (rv == -1)
  747.     return EOF_VAL;
  748.   else
  749.     {
  750.       rv = isatty (rv);
  751.       return  rv ? BOOL_T : BOOL_F;
  752.     }
  753. }
  754.  
  755.  
  756.  
  757. PROC (s_sys_fdopen, "%fdopen", 2, 0, 0, scm_sys_fdopen);
  758. #ifdef __STDC__
  759. SCM
  760. scm_sys_fdopen (SCM fdes, SCM modes)
  761. #else
  762. SCM
  763. scm_sys_fdopen (fdes, modes)
  764.      SCM fdes;
  765.      SCM modes;
  766. #endif
  767. {
  768.   FILE *f;
  769.   SCM port;
  770.  
  771.   ASSERT (INUMP (fdes), fdes, ARG1, s_sys_fdopen);
  772.   ASSERT (NIMP (modes) && STRINGP (modes), modes, ARG2, s_sys_fdopen);
  773.   DEFER_INTS;
  774.   f = fdopen (INUM (fdes), CHARS (modes));
  775.   if (f == NULL)
  776.     {
  777.       ALLOW_INTS;
  778.       return BOOL_F;
  779.     }
  780.   NEWCELL (port);
  781.   CAR (port) = tc16_fport | scm_mode_bits (CHARS (modes));
  782.   SETSTREAM (port,f);
  783.   scm_add_to_port_table (port);
  784.   ALLOW_INTS;
  785.   return port;
  786. }
  787.  
  788.  
  789.  
  790. /* Move a port's underlying file descriptor to a given value.
  791.  * Returns: #f for error.
  792.  *           0 if fdes is already the given value.
  793.  *           1 if fdes moved. 
  794.  * MOVE->FDES is implemented in Scheme and calls this primitive.
  795.  */
  796. PROC (s_sys_primitive_move_to_fdes, "%primitive-move->fdes", 2, 0, 0, scm_sys_primitive_move_to_fdes);
  797. #ifdef __STDC__
  798. SCM
  799. scm_sys_primitive_move_to_fdes (SCM port, SCM fd)
  800. #else
  801. SCM
  802. scm_sys_primitive_move_to_fdes (port, fd)
  803.      SCM port;
  804.      SCM fd;
  805. #endif
  806. {
  807.   FILE *stream;
  808.   int old_fd;
  809.   int new_fd;
  810.   int rv;
  811.  
  812.   ASSERT (NIMP (port) && OPFPORTP (port), port, ARG1, s_sys_primitive_move_to_fdes);
  813.   ASSERT (INUMP (fd), fd, ARG2, s_sys_primitive_move_to_fdes);
  814.   DEFER_INTS;
  815.   stream = STREAM (port);
  816.   old_fd = fileno (stream);
  817.   new_fd = INUM (fd);
  818.   if  (old_fd == new_fd)
  819.     {
  820.       ALLOW_INTS;
  821.       return MAKINUM (0);
  822.     }
  823.   scm_evict_ports (new_fd);
  824.   rv = dup2 (old_fd, new_fd);
  825.   if (rv == -1)
  826.     {
  827.       ALLOW_INTS;
  828.       return BOOL_F;
  829.     }
  830.   scm_setfileno (stream, new_fd);
  831.   SYSCALL (close (old_fd));  
  832.   ALLOW_INTS;
  833.   return MAKINUM (1);
  834. }
  835.  
  836.  
  837.  
  838. PROC (s_sys_access, "%access", 2, 0, 0, scm_sys_access);
  839. #ifdef __STDC__
  840. SCM 
  841. scm_sys_access (SCM path, SCM how)
  842. #else
  843. SCM 
  844. scm_sys_access (path, how)
  845.      SCM path;
  846.      SCM how;
  847. #endif
  848. {
  849.   int rv;
  850.   int ihow;
  851.   ASSERT (NIMP (path) && STRINGP (path), path, ARG1, s_sys_access);
  852.   ASSERT (INUMP (how), how, ARG2, s_sys_access);
  853.   /* "how" values are interned in scm_init_ioext.  */
  854.   rv = access (CHARS (path), INUM (how));
  855.   return rv ? BOOL_F : BOOL_T;
  856. }
  857.  
  858.  
  859.  
  860. SCM scm_stat2scm P ((struct stat * stat_temp));
  861. PROC (s_sys_stat, "%stat", 1, 0, 0, scm_sys_stat);
  862. #ifdef __STDC__
  863. SCM 
  864. scm_sys_stat (SCM port_or_path)
  865. #else
  866. SCM 
  867. scm_sys_stat (port_or_path)
  868.      SCM port_or_path;
  869. #endif
  870. {
  871.   int rv;
  872.   struct stat stat_temp;
  873.   ASSERT (NIMP (port_or_path), port_or_path, ARG1, s_sys_stat);
  874. #ifdef MCH_AMIGA
  875.   ASSERT (STRING (port_or_path), port_or_path, ARG1, s_sys_stat);
  876. #endif
  877.   if (STRINGP (port_or_path))
  878.     SYSCALL (rv = stat (CHARS (port_or_path), &stat_temp));
  879. #ifndef MCH_AMIGA
  880.   else
  881.     {
  882.       ASSERT (OPFPORTP (port_or_path), port_or_path, ARG1, s_sys_stat);
  883.       DEFER_INTS;
  884.       rv = fileno (STREAM (port_or_path));
  885.       ALLOW_INTS;
  886.       if (rv != -1)
  887.     SYSCALL (rv = fstat (rv, &stat_temp));
  888.     }
  889. #endif
  890.   return rv ? BOOL_F : scm_stat2scm (&stat_temp);
  891. }
  892.  
  893.  
  894.  
  895. #ifdef __STDC__
  896. SCM 
  897. scm_stat2scm (struct stat *stat_temp)
  898. #else
  899. SCM 
  900. scm_stat2scm (stat_temp)
  901.      struct stat *stat_temp;
  902. #endif
  903. {
  904.   SCM ans = scm_make_vector (MAKINUM (13), UNSPECIFIED);
  905.   SCM *ve = VELTS (ans);
  906.   ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev);
  907.   ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_ino);
  908.   ve[2] = scm_ulong2num ((unsigned long) stat_temp->st_mode);
  909.   ve[3] = scm_ulong2num ((unsigned long) stat_temp->st_nlink);
  910.   ve[4] = scm_ulong2num ((unsigned long) stat_temp->st_uid);
  911.   ve[5] = scm_ulong2num ((unsigned long) stat_temp->st_gid);
  912. #ifdef HAVE_ST_RDEV
  913.   ve[6] = scm_ulong2num ((unsigned long) stat_temp->st_rdev);
  914. #else
  915.   ve[6] = BOOL_F;
  916. #endif
  917.   ve[7] = scm_ulong2num ((unsigned long) stat_temp->st_size);
  918.   ve[8] = scm_ulong2num ((unsigned long) stat_temp->st_atime);
  919.   ve[9] = scm_ulong2num ((unsigned long) stat_temp->st_mtime);
  920.   ve[10] = scm_ulong2num ((unsigned long) stat_temp->st_ctime);
  921. #ifdef AC_STRUCT_ST_BLKSIZE
  922.   ve[11] = scm_ulong2num ((unsigned long) stat_temp->st_blksize);
  923. #else
  924.   ve[11] = scm_ulong2num (4096L);
  925. #endif
  926. #ifdef AC_STRUCT_ST_BLOCKS
  927.   ve[12] = scm_ulong2num ((unsigned long) stat_temp->st_blocks);
  928. #else
  929.   ve[12] = BOOL_F;
  930. #endif
  931.  
  932.   return ans;
  933. }
  934.  
  935.  
  936.  
  937. PROC (s_getpid, "getpid", 0, 0, 0, scm_getpid);
  938. #ifdef __STDC__
  939. SCM 
  940. scm_getpid (void)
  941. #else
  942. SCM 
  943. scm_getpid ()
  944. #endif
  945. {
  946.   return MAKINUM ((unsigned long) getpid ());
  947. }
  948.  
  949.  
  950.  
  951. PROC (s_sys_putenv, "%putenv", 1, 0, 0, scm_sys_putenv);
  952. #ifdef __STDC__
  953. SCM
  954. scm_sys_putenv (SCM str)
  955. #else
  956. SCM
  957. scm_sys_putenv (str)
  958.      SCM str;
  959. #endif
  960. {
  961. #ifdef HAVE_PUTENV
  962.   ASSERT (NIMP (str) && STRINGP (str), str, ARG1, s_sys_putenv);
  963.   return putenv (CHARS (str)) ? BOOL_F : BOOL_T;
  964. #else
  965.   return BOOL_F;
  966. #endif
  967. }
  968.  
  969.  
  970.  
  971. void 
  972. scm_init_ioext ()
  973. {
  974.   /* fseek() symbols.  */
  975.   scm_sysintern ("SEEK_SET", MAKINUM (SEEK_SET));
  976.   scm_sysintern ("SEEK_CUR", MAKINUM (SEEK_CUR));
  977.   scm_sysintern ("SEEK_END", MAKINUM (SEEK_END));
  978.  
  979.   /* access() symbols.  */
  980.   scm_sysintern ("R_OK", MAKINUM (R_OK));
  981.   scm_sysintern ("W_OK", MAKINUM (W_OK));
  982.   scm_sysintern ("X_OK", MAKINUM (X_OK));
  983.   scm_sysintern ("F_OK", MAKINUM (F_OK));
  984.  
  985.   /* File type/permission bits.  */
  986. #ifdef S_IRUSR
  987.   scm_sysintern ("S_IRUSR", MAKINUM (S_IRUSR));
  988. #endif
  989. #ifdef S_IWUSR
  990.   scm_sysintern ("S_IWUSR", MAKINUM (S_IWUSR));
  991. #endif
  992. #ifdef S_IXUSR
  993.   scm_sysintern ("S_IXUSR", MAKINUM (S_IXUSR));
  994. #endif
  995. #ifdef S_IRWXU
  996.   scm_sysintern ("S_IRWXU", MAKINUM (S_IRWXU));
  997. #endif
  998.  
  999. #ifdef S_IRGRP
  1000.   scm_sysintern ("S_IRGRP", MAKINUM (S_IRGRP));
  1001. #endif
  1002. #ifdef S_IWGRP
  1003.   scm_sysintern ("S_IWGRP", MAKINUM (S_IWGRP));
  1004. #endif
  1005. #ifdef S_IXGRP
  1006.   scm_sysintern ("S_IXGRP", MAKINUM (S_IXGRP));
  1007. #endif
  1008. #ifdef S_IRWXG
  1009.   scm_sysintern ("S_IRWXG", MAKINUM (S_IRWXG));
  1010. #endif
  1011.  
  1012. #ifdef S_IROTH
  1013.   scm_sysintern ("S_IROTH", MAKINUM (S_IROTH));
  1014. #endif
  1015. #ifdef S_IWOTH
  1016.   scm_sysintern ("S_IWOTH", MAKINUM (S_IWOTH));
  1017. #endif
  1018. #ifdef S_IXOTH
  1019.   scm_sysintern ("S_IXOTH", MAKINUM (S_IXOTH));
  1020. #endif
  1021. #ifdef S_IRWXO
  1022.   scm_sysintern ("S_IRWXO", MAKINUM (S_IRWXO));
  1023. #endif
  1024.  
  1025. #ifdef S_ISUID
  1026.   scm_sysintern ("S_ISUID", MAKINUM (S_ISUID));
  1027. #endif
  1028. #ifdef S_ISGID
  1029.   scm_sysintern ("S_ISGID", MAKINUM (S_ISGID));
  1030. #endif
  1031. #ifdef S_ISVTX
  1032.   scm_sysintern ("S_ISVTX", MAKINUM (S_ISVTX));
  1033. #endif
  1034.  
  1035. #ifdef S_IFMT
  1036.   scm_sysintern ("S_IFMT", MAKINUM (S_IFMT));
  1037. #endif
  1038. #ifdef S_IFDIR
  1039.   scm_sysintern ("S_IFDIR", MAKINUM (S_IFDIR));
  1040. #endif
  1041. #ifdef S_IFCHR
  1042.   scm_sysintern ("S_IFCHR", MAKINUM (S_IFCHR));
  1043. #endif
  1044. #ifdef S_IFBLK
  1045.   scm_sysintern ("S_IFBLK", MAKINUM (S_IFBLK));
  1046. #endif
  1047. #ifdef S_IFREG
  1048.   scm_sysintern ("S_IFREG", MAKINUM (S_IFREG));
  1049. #endif
  1050. #ifdef S_IFLNK
  1051.   scm_sysintern ("S_IFLNK", MAKINUM (S_IFLNK));
  1052. #endif
  1053. #ifdef S_IFSOCK
  1054.   scm_sysintern ("S_IFSOCK", MAKINUM (S_IFSOCK));
  1055. #endif
  1056. #ifdef S_IFIFO
  1057.   scm_sysintern ("S_IFIFO", MAKINUM (S_IFIFO));
  1058. #endif
  1059.  
  1060.   scm_add_feature ("i/o-extensions");
  1061.   scm_add_feature ("line-i/o");
  1062. #ifdef HAVE_PIPE
  1063. /*
  1064.   scm_ptobs[0x0ff & (tc16_pipe >> 8)].fclose = pclose;
  1065.   scm_ptobs[0x0ff & (tc16_pipe >> 8)].free = pclose;
  1066.   scm_ptobs[0x0ff & (tc16_pipe >> 8)].print = prinpipe;
  1067.   scm_add_feature (s_pipe);
  1068. */
  1069. #endif
  1070.  
  1071.   scm_tc16_dir = scm_newsmob (&dir_smob);
  1072. #include "ioext.x"
  1073. }
  1074.  
  1075.